Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue28/excel/EXCEL.ZIP/EXCELS.PAS

Pascal/Delphi Source File | 1997-08-07 | 9.2 KB | 351 lines

{*****************************************************}
{       TExcel Component 3.1 for Delphi 1.0 .. 3.0    }
{                                                     }
{       Copyright (c) 1996, 1997 Tibor F. Liska       }
{       Tel/Fax:    [phone]                    }
{       Office:     [phone]                    }
{       E-mail: [e-mail]                       }
{*****************************************************}
unit Excels;

interface

uses Forms, Classes, DdeMan, SysUtils;

type
  TExcel = class(TComponent)
  private
      FMacro     : TFileName;
      FMacroPath : TFileName;
      FDDE       : TDdeClientConv;
      FConnected : Boolean;
      FExeName   : TFileName;
      FDecimals  : Integer;
      FSeparator : Char;
      FWaitAfter : Integer;
      FDone      : Integer;
      FOnClose   : TNotifyEvent;
      FOnOpen    : TNotifyEvent;
    procedure SetExeName(const Value: TFileName);
    function  GetSelection: string;
    procedure SetConnect(const Value: Boolean);
    function GetReady: Boolean;
  protected
    procedure OpenLink(Sender: TObject);
    procedure ShutDown(Sender: TObject);
    procedure LocateExcel;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Connect;
    procedure Disconnect;
    procedure Wait;
    function Request(const Item: string): string;
    procedure Exec  (const Cmd : string);
    procedure Run   (const Mn  : string);
    procedure Filter(const Txt : string); virtual;
    procedure Select(Row, Col: Integer);
    procedure PutStr(Row, Col: Integer; const s: string);
    procedure PutExt(Row, Col: Integer; e: Extended);
    procedure PutInt(Row, Col: Integer; i: Longint);
    procedure PutDay(Row, Col: Integer; d: TDateTime);
    function GetCell(Row, Col: Integer): string;
    procedure OpenMacroFile(const Fn: TFileName; Hide: Boolean);
    procedure CloseMacroFile;
    procedure StartTable(Create: Boolean);
    procedure EndTable;
    property DDE: TDdeCLientConv   read FDDE;
    property Connected: Boolean    read FConnected write SetConnect;
    property Ready    : Boolean    read GetReady;
    property Selection: string     read GetSelection;
  published
    property ExeName  : TFileName  read FExeName   write SetExeName;
    property Decimals : Integer    read FDecimals  write FDecimals;
    property Separator: Char       read FSeparator write FSeparator;
    property WaitAfter: Integer    read FWaitAfter write FWaitAfter;
    property OnClose: TNotifyEvent read FOnClose   write FOnClose;
    property OnOpen : TNotifyEvent read FOnOpen    write FOnOpen;
  end;

procedure Register;

const                 { Message strings can be nationalized }
     msgCannotRun     = 'Excel cannot be lunched';
     msgNoConnect     = 'Excel not connected';
     msgTableNotReady = 'Table is not ready';
     msgNoReply       = '*** No Reply ***';
     msgNotAccepted   ='" not accepted by Excel';
     msgNoMacro       = 'Macro is not opened';
     msgNoTable       = 'Table is not opened';

implementation
uses WinTypes, WinProcs, ShellAPI;

procedure Register;
begin
  RegisterComponents('Liska', [TExcel]);
end;

{ TExcel }

constructor TExcel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if not (csDesigning in ComponentState) then
  begin
    FDDE := TDdeClientConv.Create(nil);
    FDDE.ConnectMode := ddeManual;
    FDDE.OnOpen  := OpenLink;
    FDDE.OnClose := ShutDown;
  end;
  SetExeName('Excel');
  FDecimals := 2;
  FSeparator := DecimalSeparator;
  FWaitAfter := 100;
  FDone := 0;
end;

destructor TExcel.Destroy;
begin
  if not (csDesigning in ComponentState) then
    FDDE.Free;
  inherited Destroy;
end;

procedure TExcel.SetExeName(const Value: TFileName);
begin
  Disconnect;
  FExeName := ChangeFileExt(Value, '');
  if not (csDesigning in ComponentState) then
    FDDE.ServiceApplication := FExeName;
end;

function TExcel.GetSelection: string;
begin
  Result := Request('Selection');
end;

procedure TExcel.SetConnect(const Value: Boolean);
begin
  if FConnected = Value then Exit;
  if Value then Connect
           else Disconnect;
end;

function TExcel.GetReady: Boolean;
begin
  Result := 'Ready' = Request('Status');
end;

procedure TExcel.OpenLink(Sender: TObject);
begin
  FConnected := True;
  if Assigned(FOnOpen) then FOnOpen(Self);
end;

procedure TExcel.ShutDown(Sender: TObject);
begin
  FConnected := False;
  if Assigned(FOnClose) then FOnClose(Self);
end;

procedure TExcel.LocateExcel;
  const
      BuffSize = 255;
  var
      Buff: array[0..BuffSize] of Char;
      Fn  : string;
      Len : Longint;
begin
  Len := BuffSize;
  StrPCopy(Buff, '.XLS');
  if (RegQueryValue(HKEY_CLASSES_ROOT, Buff, Buff, Len)
    = ERROR_SUCCESS) and (StrScan(Buff,'E') <> nil) then
  begin
    StrCat(Buff, '\Shell\Open\Command');
    Len := BuffSize;
    if RegQueryValue(HKEY_CLASSES_ROOT, Buff, Buff, Len)
      = ERROR_SUCCESS then
    begin
      Fn := StrPas(StrUpper(Buff));
      Len := Pos('EXCEL.EXE', Fn);
      Delete(Fn, Len + Length('EXCEL.EXE'), 255);
      if Buff[0] = '"' then Delete(Fn, 1, 1);
      if FileExists(Fn) then
        ExeName := Fn;
    end;
  end;
end;

procedure TExcel.Connect;
begin
  if FConnected then Exit;
  FDDE.SetLink('Excel', 'System');
  if FDDE.OpenLink then Exit;
  LocateExcel;
  if FDDE.OpenLink then Exit;            { Try again }
  Application.ProcessMessages;
  if FDDE.OpenLink then Exit;            { Once more }
  raise Exception.Create(msgCannotRun);
end;

procedure TExcel.Disconnect;
begin
  if FConnected then FDDE.CloseLink;
end;

procedure TExcel.Wait;
begin
  Application.ProcessMessages;
  FDone := 0;
  while not Ready do
    Application.ProcessMessages;      { Waiting for Excel }
end;

function TExcel.Request(const Item: string): string;
  var
      Reply : PChar;
begin
  Application.ProcessMessages;
  Reply := FDDE.RequestData(Item);
  if Reply = nil then Result := msgNoReply
                 else Result := StrPas(Reply);
  StrDispose(Reply);
end;

procedure TExcel.Exec(const Cmd: string);
  var
      a : array[0..255] of Char;
begin
  if not FConnected then
    raise Exception.Create(msgNoConnect);
  Inc(FDone);
  if FDone < FWaitAfter then Application.ProcessMessages
                        else Wait;
  StrPCopy(a, Cmd);
  if FDDE.ExecuteMacro(a, False) then Exit
                                 else Wait;
  if FDDE.ExecuteMacro(a, True ) then Exit;
  raise Exception.Create('"' + Cmd + msgNotAccepted);
end;

procedure TExcel.Run(const Mn: string);
begin
  if FMacro = '' then
    raise Exception.Create(msgNoMacro);
  Exec('[RUN("' + FMacro + '!' + Mn + '";FALSE)]');
end;

procedure TExcel.Filter(const Txt: string);
  var
     i : Integer;
     Send : string;
begin
  Send := Txt;
  i := Pos('"', Send);
  while i > 0 do
  begin
    Send[i] := '''';             { Filter out " }
    i := Pos('"', Send);
  end;
  Exec('[FORMULA("'+Send+'")]');
end;

procedure TExcel.Select(Row, Col: Integer);
begin
  Exec(Format('[SELECT("R%dC%d")]', [Row, Col]));
end;

procedure TExcel.PutStr(Row, Col: Integer; const s: string);
begin
  Exec(Format('[FORMULA("%s","R%dC%d")]', [s, Row, Col]));
end;

procedure TExcel.PutExt(Row, Col: Integer; e: Extended);
  var
     s : string;
     i : Integer;
begin
  Str(e:0:Decimals, s);
  if Separator <> '.' then
  begin
    i := Pos('.', s);
    if i > 0 then s[i] := Separator;
  end;
  PutStr(Row, Col, s);
end;

procedure TExcel.PutInt(Row, Col: Integer; i: Longint);
begin
  PutStr(Row, Col, IntToStr(i));
end;

procedure TExcel.PutDay(Row, Col: Integer; d: TDateTime);
begin
  PutStr(Row, Col, DateToStr(d));
end;

function TExcel.GetCell(Row, Col: Integer): string;
  var
      Topic : string;
      i : Integer;
      OldOpen,
      OldClose : TNotifyEvent;
begin
  OldOpen  := FOnOpen;
  OldClose := FOnClose;
  FOnOpen  := nil;
  FOnClose := nil;
try
  Topic := Request('Selection');
  i := Pos('!', Topic);
  if i = 0 then raise Exception.Create(msgNoTable);
  FDDE.SetLink('Excel', Copy(Topic, 1, i-1));
  if FDDE.OpenLink then Result := Request(Format('R%dC%d', [Row, Col]))
                   else Result := msgNoReply;
finally
  FDDE.SetLink('Excel', 'System');
  FDDE.OpenLink;
  FOnOpen := OldOpen;
  FOnClose:= OldClose;
end; end;

procedure TExcel.OpenMacroFile(const Fn: TFileName; Hide: Boolean);
begin
  if FMacroPath = Fn then Exit;
  CloseMacroFile;
  Exec('[OPEN("' + Fn + '")]');
  if Hide then Exec('[HIDE()]');
  FMacroPath := Fn;
  FMacro := ExtractFileName(Fn);
end;

procedure TExcel.CloseMacroFile;
begin
  if FMacro <> '' then
  try
    Exec('[UNHIDE("' + FMacro + '")]');
    Exec('[ACTIVATE("' + FMacro + '")]');
    Exec('[CLOSE(FALSE)]');
  finally
    FMacro := '';
    FMacroPath := '';
  end;
end;

procedure TExcel.StartTable(Create: Boolean);
begin
  Exec('[APP.MINIMIZE()]');
  if Create then Exec('[NEW(1)]');
  PutStr(1, 1, msgTableNotReady);
  FDone := 0;
end;

procedure TExcel.EndTable;
begin
  PutStr(1, 1, '');
  Exec('[APP.RESTORE()]');
  FDone := 0;
end;

end.